Atari Mega Archive 1/Atari Mega Archive - Volume 1.iso/language/forth_83.zoo/disass.scr

Text File | 1992-04-07 | 22KB | 1 lines

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ 68000 Disassembler loadscreen                        14oct86we                                                                Onlyforth                                                                                                                       \needs >absaddr    : >absaddr     0 forthstart d+ ;             \needs Code        include assemble.scr                                                                                         1 ?head !       \ alle Disassembler-Worte headerless            1 $12 +thru                                                                                                                     0 ?head !                                                       $13 +load       \ Benutzer-Worte mit Header                                                                                                                                                                                                                                                                                     \ long words and presigns                              14oct86we                                                                : l+    ( n -- )    extend d+  ;                                : l-    ( n -- )    extend d-  ;                                : l+!   ( n addr -- )   >absaddr  ln+! ;                                                                                        : .#    Ascii # emit ;                                          : .$    Ascii $ emit ;                                          : .,    Ascii , emit ;                                          : .-    Ascii - emit ;                                          : ..    Ascii . emit ;                                                                                                          : .0r   ( n width --)   over abs swap                             <# 0 DO # LOOP swap sign #>  type space ;                                                                                                                                                     \ signed / unsigned byte, word and long output         28jan86ma                                                                : .lformat   ( laddr --)  <# #s #> dup 8 swap - spaces type ;                                                                   : .lu   ( d -- )       <# #s #> type   ;                        : .$lu  ( d -- )       .$ .lu ;                                                                                                 : .wo   ( n -- )       0  <# # # # # #>  type ;                 : .$wu  ( n -- )       .$ .wo ;                                 : .$ws  ( n -- )       dup $7FFF u>                                                      IF .- 1.0000 rot d- THEN  .$ .wo  ;    : .by   ( 8b -- )      0   <#  # #  #>   type ;                 : .$bu  ( 8b -- )      .$ .by ;                                 : .$bs  ( 8b -- )      $FF and dup $7F >                                                 IF .- 100 swap - THEN .$ .by  ;        : .lb  ( hi lo len -- )   bounds ?DO  I over lc@ .by  LOOP  ;   \ Variables and tabs                                   18jan86ma                                                                2Variable addr    2Variable dispaddr    2Variable saveaddr      Variable  opcode  Variable  mne         Variable  mode          Variable  reg     Variable  length      Variable  sr            Variable  predec                                                                                                                  &10 constant  bytfld       : tab     row  swap   at ;           &32 constant  mnefld                                            &40 constant  adrfld       : tab1    row  adrfld at ;                                                                         : getword                                                          addr 2@  2 l+  2dup  addr 2!  l@ ;                           : getlong                                                          addr 2@  4 l+  2dup  addr 2!  2dup  2 l-  l@ >r  l@ r>   ;                                                                   \ print registernumber, dump                           18jan86ma                                                                : .reg      ( n -- )   7 and  Ascii 0 +  emit ;                 : .(areg)   ( n -- )   Ascii A emit .reg ;                      : .(dreg)   ( n -- )   Ascii D emit .reg ;                                                                                      : .areg                reg @ .(areg) ;                          : .dreg                reg @ .(dreg) ;                                                                                          : .aind                Ascii ( emit .areg Ascii ) emit ;        : .apost               .aind Ascii + emit ;                     : .apre                .- .aind ;                                                                                               : dumpws               getword .$ws ;                           : dumpw                getword .$wu ;                           : dumpl                getlong .$lu ;                           \ print length , bitmasking                            04mar86we                                                                : len.    length @                                                    0   case? IF  ." .b"  tab1 exit  THEN                           1   case? IF  ." .w"  tab1 exit  THEN                           2   case? IF  ." .l"  tab1 exit  THEN                               tab1  drop ;                                                                                                          Code shift   ( n -- )   SP )+ D0 move  SP ) D1 move                                     D0 D1 lsr  D1 SP ) move   Next end-code : 4shft   4 shift ;             : 8shft   8 shift  ;            : cshft   $0C shift ;                                           : bitce   $0C shift 7 and ;     : bit5     5 shift  1 and ;     : bit6    6 shift   1 and ;     : bit7     7 shift  1 and ;     : bit10   $0A shift 1 and ;     : bit11  $0B shift  1 and ;     : bit8b   8 shift $0F and ;                                     \ bitmasking 2                                         28jan86ma                                                                : bit02   7 and ;                : bit8    8 shift  1 and ;     : bit35   3 shift  7 and ;       : bit3    3 shift  1 and ;     : bit68   6 shift  7 and ;       : bit9b   9 shift  7 and ;     : bit67   6 shift  3 and ;       : bit37   3 shift  $1F and ;                                                                   : len!.      length ! len. ;                                    : length6    opcode @ bit6 1+ len!. ;                           : length67   opcode @ bit67   len!. ;                                                                                           : reg02!     opcode @ bit02   reg ! ;                           : reg9b!     opcode @ bit9b   reg ! ;                                                                                           : bit9b.    .# opcode @ bit9b dup 0=                                           IF drop 8 THEN  .$bu ;